signature COLOR =
sig
	structure Frame : FRAME

	type allocation = Frame.register Temp.Table.table

	val color : {interference : Liveness.igraph,
		     initial      : allocation,
		     spillCost    : Graph.node -> int,
		     registers    : Frame.register list} -> allocation * Temp.temp list
end

structure Color : COLOR =
struct 
  structure E = ErrorMsg
  structure F = MipsFrame
  structure G = Graph
  structure GB = G.Table
  structure L = Liveness
  structure M = Temp
  structure MB = M.Table

  structure LST = List
  structure OPT = Option
		

  type allocation = F.register MB.table

  fun color {interference=L.IGRAPH{graph, tnode, gtemp, moves},
	     initial,
	     spillCost,
	     registers} =

      let val numRegs = length registers
	  val nodes = G.nodes graph
	  val degree = foldr (fn (n, t) => GB.enter (t, n, ref (length (G.succ n))))
			     GB.empty
			     nodes

	  val K = length registers

	  val stack =
	      let val stack = ref []
			      
		  val worklist = ref (foldr (fn (n, ns) => case GB.look (degree, n)
							    of NONE    => E.impossible "NODE WITH NO DEGREE"
							     | SOME zr => if (!zr < K)
									  then n::ns
									  else ns)
					    []
					    nodes)
				 
		  fun simplify () = case !worklist
				     of []      => app (fn n => if (length (G.adj n) > 0)
								  then E.impossible "COLOR: NEED TO SPILL"
								  else ())
						       nodes
				      | (n::ns) => ( worklist := ns
						   ; stack := (n::(!stack))
						   ; app (fn n' => case GB.look (degree, n')
								    of NONE    => E.impossible "NODE WITH NO DEGREE"
								     | SOME zr => ( zr := !zr - 1
									       ; if K = !zr
										 then worklist := n' :: (!worklist)
										 else ()
									       ))
							 (G.adj n)
						   )
						   
	      in ( while (not (null (!worklist))) do
		       simplify ()
		 ; !stack
		 )
	      end

	  val coloring = let val colorTable = ref initial
			     fun assignOne n = case MB.look (!colorTable, gtemp n) of
					 SOME reg => () (* precolored *)
				       | NONE => let val adjacentRegisters = foldr (fn (n, cs) => case MB.look (!colorTable, gtemp n)
												   of NONE   => cs
												    | SOME c => c::cs)
										   []
										   (G.succ n)

						     val availableRegisters = LST.filter (fn reg => LST.all (fn reg' => reg<>reg')
													    adjacentRegisters)
											 registers

						 in case availableRegisters
						     of [] => E.impossible "NOT ENOUGH REGISTERS: NEED COALESCING OR SPILLING"
						      | (reg::regs) => colorTable := MB.enter (!colorTable, gtemp n, reg)
						 end
			 in ( app assignOne stack
			    ; !colorTable
			    )
			 end
      in (coloring, [])
      end

      structure Frame = F
end
